Networked Data Lab long chart on children and young people’s mental health

#Subsample of metrics from MHSDS data
CAMHS_data <- MHSDS_main_pooled_dashboard %>%
  filter(PRIMARY_LEVEL_DESCRIPTION=="England",
         MEASURE_ID %in% c("CYP01","MHS61a","CYP23","MHS30d","MHS32a")) %>%
  filter(.,!(MEASURE_ID=="MHS32a"&BREAKDOWN!="England")) %>% 
  mutate(MEASURE_KEY=case_when(
           MEASURE_ID=="MHS30d" ~ "Attended contacts (<18)",
           MEASURE_ID=="CYP01" ~ "People in contact",
           MEASURE_ID=="MHS61a" ~ "First contacts (<18)",
           MEASURE_ID=="CYP23" ~ "Open referrals",
           MEASURE_ID=="MHS32a" ~ "New referrals (<18)",
           TRUE ~ "NA"
         )) %>% 
  select(.,start_date,end_date,month_year,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_KEY,MEASURE_VALUE) %>% 
  mutate(.,MEASURE_VALUE=as.numeric(MEASURE_VALUE),
         timing=ifelse(start_date<ymd("2020-04-01"),"Pre-COVID","Post-COVID")) %>%
  mutate(.,timing=fct_relevel(timing, c("Pre-COVID","Post-COVID"))) %>% 
  arrange(.,start_date) %>%
  as_tibble()

#Percentage change compared to a year ago
#For example, for March 2020 show the % change between March 2019 and March 2020

CAMHS_yearly_changes <- CAMHS_data %>%
  select(.,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_KEY,MEASURE_VALUE,start_date,month_year,timing) %>%
  mutate(start_date=lubridate::ymd(start_date)) %>%
  mutate(.,start_date_l1=start_date-years(1)) #Adds a new column with the month a year before

#Auxiliary dataset with data points from a year before
CAMHS_data_l1 <- CAMHS_yearly_changes %>%
  select(.,start_date,MEASURE_VALUE,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_KEY) %>%
  rename(.,MEASURE_VALUE_l1=MEASURE_VALUE,start_date_l1=start_date)

#Merge auxiliary data back in
CAMHS_yearly_changes <- left_join(CAMHS_yearly_changes,
                                          CAMHS_data_l1,
                                          by=c("start_date_l1","PRIMARY_LEVEL_DESCRIPTION","MEASURE_ID","MEASURE_KEY")) %>%
  arrange(.,MEASURE_ID,start_date) %>%
  mutate(pct_change_l1=(MEASURE_VALUE-MEASURE_VALUE_l1)/MEASURE_VALUE_l1*100) %>%
  filter(.,!is.na(pct_change_l1))
rm(CAMHS_data_l1)

People in contact with CAMHS

• Measure code: CYP01
• Measure description: People in contact with children and young people’s mental health services at the end of the reporting period
• Source: NHS England, Monthly MHSDS Statistics, Metadata

Raw time series

#Data
CAMHS_data_cyp01 <- CAMHS_data %>%
  filter(.,MEASURE_ID=="CYP01")
CAMHS_reldata_cyp01 <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="CYP01")

#Time series chart
CAMHS_raw_chart_cyp01 <- CAMHS_data_cyp01 %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp01)

#Underlying data
CAMHS_data_cyp01 %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	MEASURE_VALUE
2018-05-01	People in contact	222,156
2018-06-01	People in contact	225,407
2018-07-01	People in contact	218,557
2018-08-01	People in contact	213,702
2018-09-01	People in contact	218,764
2018-10-01	People in contact	227,845
2018-11-01	People in contact	223,744
2018-12-01	People in contact	227,679
2019-01-01	People in contact	229,217
2019-02-01	People in contact	233,831
2019-03-01	People in contact	241,926
2019-04-01	People in contact	218,678
2019-05-01	People in contact	230,443
2019-06-01	People in contact	225,480
2019-07-01	People in contact	226,647
2019-08-01	People in contact	218,826
2019-09-01	People in contact	221,428
2019-10-01	People in contact	225,507
2019-11-01	People in contact	230,739
2019-12-01	People in contact	231,056
2020-01-01	People in contact	236,396
2020-02-01	People in contact	240,401
2020-03-01	People in contact	237,088
2020-04-01	People in contact	281,199
2020-05-01	People in contact	273,706
2020-06-01	People in contact	272,529
2020-07-01	People in contact	275,439
2020-08-01	People in contact	271,462
2020-09-01	People in contact	286,880
2020-10-01	People in contact	296,414
2020-11-01	People in contact	309,311
2020-12-01	People in contact	311,119
2021-01-01	People in contact	307,335
2021-02-01	People in contact	306,997
2021-03-01	People in contact	317,845
2021-04-01	People in contact	323,240
2021-05-01	People in contact	337,426
2021-06-01	People in contact	340,694
2021-07-01	People in contact	342,565
2021-08-01	People in contact	331,912
2021-09-01	People in contact	337,080

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp01 %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")

MEASURE_ID	MEASURE_KEY	year	average	months_included
CYP01	People in contact	2019	227814.8	12
CYP01	People in contact	2020	274328.7	12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp01 <- CAMHS_reldata_cyp01 %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contactsn (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp01)

#Underlying data
CAMHS_reldata_cyp01 %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	pct_change_l1
2019-05-01	People in contact	3.7302616
2019-06-01	People in contact	0.0323859
2019-07-01	People in contact	3.7015515
2019-08-01	People in contact	2.3977314
2019-09-01	People in contact	1.2177506
2019-10-01	People in contact	-1.0261362
2019-11-01	People in contact	3.1263408
2019-12-01	People in contact	1.4832286
2020-01-01	People in contact	3.1319667
2020-02-01	People in contact	2.8097216
2020-03-01	People in contact	-1.9997851
2020-04-01	People in contact	28.5904389
2020-05-01	People in contact	18.7738400
2020-06-01	People in contact	20.8661522
2020-07-01	People in contact	21.5277502
2020-08-01	People in contact	24.0538144
2020-09-01	People in contact	29.5590440
2020-10-01	People in contact	31.4433698
2020-11-01	People in contact	34.0523275
2020-12-01	People in contact	34.6509071
2021-01-01	People in contact	30.0085450
2021-02-01	People in contact	27.7020478
2021-03-01	People in contact	34.0620360
2021-04-01	People in contact	14.9506222
2021-05-01	People in contact	23.2804542
2021-06-01	People in contact	25.0120171
2021-07-01	People in contact	24.3705503
2021-08-01	People in contact	22.2683101
2021-09-01	People in contact	17.4986057

New referrals (<18)

• Measure code: MHS32a
• Measure description: Referrals starting in RP, aged 0-18
• Source: NHS England, Monthly MHSDS Statistics, Metadata

Raw time series

#Data
CAMHS_data_cyp32a <- CAMHS_data %>%
  filter(.,MEASURE_ID=="MHS32a")
CAMHS_reldata_cyp32a <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="MHS32a")

#Time series chart
CAMHS_raw_chart_cyp32a <- CAMHS_data_cyp32a %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp32a)

#Underlying data
CAMHS_data_cyp32a %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	MEASURE_VALUE
2019-04-01	New referrals (<18)	64,095
2019-05-01	New referrals (<18)	71,119
2019-06-01	New referrals (<18)	67,449
2019-07-01	New referrals (<18)	71,743
2019-08-01	New referrals (<18)	46,403
2019-09-01	New referrals (<18)	64,284
2019-10-01	New referrals (<18)	83,290
2019-11-01	New referrals (<18)	79,100
2019-12-01	New referrals (<18)	65,547
2020-01-01	New referrals (<18)	84,624
2020-02-01	New referrals (<18)	80,555
2020-03-01	New referrals (<18)	72,532
2020-04-01	New referrals (<18)	41,411
2020-05-01	New referrals (<18)	46,262
2020-06-01	New referrals (<18)	60,370
2020-07-01	New referrals (<18)	67,967
2020-08-01	New referrals (<18)	51,357
2020-09-01	New referrals (<18)	75,222
2020-10-01	New referrals (<18)	88,523
2020-11-01	New referrals (<18)	92,228
2020-12-01	New referrals (<18)	75,841
2021-01-01	New referrals (<18)	68,149
2021-02-01	New referrals (<18)	70,169
2021-03-01	New referrals (<18)	98,112
2021-04-01	New referrals (<18)	85,598
2021-05-01	New referrals (<18)	101,421
2021-06-01	New referrals (<18)	98,037
2021-07-01	New referrals (<18)	85,801
2021-08-01	New referrals (<18)	57,289
2021-09-01	New referrals (<18)	84,264

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp32a %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")

MEASURE_ID	MEASURE_KEY	year	average	months_included
MHS32a	New referrals (<18)	2020	69741	12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp32a <- CAMHS_reldata_cyp32a %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contacts (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp32a)

#Underlying data
CAMHS_reldata_cyp32a %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	pct_change_l1
2020-04-01	New referrals (<18)	-35.391216
2020-05-01	New referrals (<18)	-34.951279
2020-06-01	New referrals (<18)	-10.495337
2020-07-01	New referrals (<18)	-5.263231
2020-08-01	New referrals (<18)	10.676034
2020-09-01	New referrals (<18)	17.015120
2020-10-01	New referrals (<18)	6.282867
2020-11-01	New referrals (<18)	16.596713
2020-12-01	New referrals (<18)	15.704762
2021-01-01	New referrals (<18)	-19.468472
2021-02-01	New referrals (<18)	-12.893054
2021-03-01	New referrals (<18)	35.267192
2021-04-01	New referrals (<18)	106.703533
2021-05-01	New referrals (<18)	119.231767
2021-06-01	New referrals (<18)	62.393573
2021-07-01	New referrals (<18)	26.239204
2021-08-01	New referrals (<18)	11.550519
2021-09-01	New referrals (<18)	12.020420

First contacts (<18)

• Measure code: MHS61a
• Measure description: First attended contacts for referrals open in the RP, aged 0-18
• Source: NHS England, Monthly MHSDS Statistics, Metadata

Raw time series

#Data
CAMHS_data_cyp61a <- CAMHS_data %>%
  filter(.,MEASURE_ID=="MHS61a")
CAMHS_reldata_cyp61a <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="MHS61a")

#Time series chart
CAMHS_raw_chart_cyp61a <- CAMHS_data_cyp61a %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp61a)

#Underlying data
CAMHS_data_cyp61a %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	MEASURE_VALUE
2019-04-01	First contacts (<18)	51,694
2019-05-01	First contacts (<18)	49,335
2019-06-01	First contacts (<18)	47,035
2019-07-01	First contacts (<18)	48,293
2019-08-01	First contacts (<18)	36,352
2019-09-01	First contacts (<18)	45,982
2019-10-01	First contacts (<18)	54,568
2019-11-01	First contacts (<18)	54,309
2019-12-01	First contacts (<18)	41,945
2020-01-01	First contacts (<18)	56,823
2020-02-01	First contacts (<18)	52,305
2020-03-01	First contacts (<18)	51,555
2020-04-01	First contacts (<18)	43,246
2020-05-01	First contacts (<18)	38,816
2020-06-01	First contacts (<18)	46,559
2020-07-01	First contacts (<18)	47,685
2020-08-01	First contacts (<18)	39,035
2020-09-01	First contacts (<18)	49,839
2020-10-01	First contacts (<18)	56,951
2020-11-01	First contacts (<18)	60,651
2020-12-01	First contacts (<18)	49,468
2021-01-01	First contacts (<18)	50,832
2021-02-01	First contacts (<18)	48,337
2021-03-01	First contacts (<18)	59,245
2021-04-01	First contacts (<18)	57,734
2021-05-01	First contacts (<18)	62,337
2021-06-01	First contacts (<18)	63,397
2021-07-01	First contacts (<18)	55,473
2021-08-01	First contacts (<18)	43,083
2021-09-01	First contacts (<18)	56,285

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp61a %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")

MEASURE_ID	MEASURE_KEY	year	average	months_included
MHS61a	First contacts (<18)	2020	49411.08	12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp61a <- CAMHS_reldata_cyp61a %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contacts (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp61a)

#Underlying data
CAMHS_reldata_cyp61a %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	pct_change_l1
2020-04-01	First contacts (<18)	-16.342322
2020-05-01	First contacts (<18)	-21.321577
2020-06-01	First contacts (<18)	-1.012012
2020-07-01	First contacts (<18)	-1.258982
2020-08-01	First contacts (<18)	7.380612
2020-09-01	First contacts (<18)	8.388065
2020-10-01	First contacts (<18)	4.367028
2020-11-01	First contacts (<18)	11.677623
2020-12-01	First contacts (<18)	17.935392
2021-01-01	First contacts (<18)	-10.543266
2021-02-01	First contacts (<18)	-7.586273
2021-03-01	First contacts (<18)	14.916109
2021-04-01	First contacts (<18)	33.501364
2021-05-01	First contacts (<18)	60.596146
2021-06-01	First contacts (<18)	36.164866
2021-07-01	First contacts (<18)	16.332180
2021-08-01	First contacts (<18)	10.370181
2021-09-01	First contacts (<18)	12.933646

Attended contacts (<18)

• Measure code: MHS30d
• Measure description: Attended contacts in the RP, aged 0-18
• Source: NHS England, Monthly MHSDS Statistics, Metadata

Raw time series

#Data
CAMHS_data_cyp30d <- CAMHS_data %>%
  filter(.,MEASURE_ID=="MHS30d")
CAMHS_reldata_cyp30d <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="MHS30d")

#Time series chart
CAMHS_raw_chart_cyp30d <- CAMHS_data_cyp30d %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp30d)

#Underlying data
CAMHS_data_cyp30d %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	MEASURE_VALUE
2019-04-01	Attended contacts (<18)	307,328
2019-05-01	Attended contacts (<18)	346,997
2019-06-01	Attended contacts (<18)	337,476
2019-07-01	Attended contacts (<18)	363,594
2019-08-01	Attended contacts (<18)	274,323
2019-09-01	Attended contacts (<18)	335,775
2019-10-01	Attended contacts (<18)	388,130
2019-11-01	Attended contacts (<18)	383,387
2019-12-01	Attended contacts (<18)	305,574
2020-01-01	Attended contacts (<18)	402,520
2020-02-01	Attended contacts (<18)	361,178
2020-03-01	Attended contacts (<18)	384,011
2020-04-01	Attended contacts (<18)	365,212
2020-05-01	Attended contacts (<18)	360,525
2020-06-01	Attended contacts (<18)	424,827
2020-07-01	Attended contacts (<18)	425,810
2020-08-01	Attended contacts (<18)	336,675
2020-09-01	Attended contacts (<18)	419,474
2020-10-01	Attended contacts (<18)	435,613
2020-11-01	Attended contacts (<18)	473,103
2020-12-01	Attended contacts (<18)	397,443
2021-01-01	Attended contacts (<18)	426,820
2021-02-01	Attended contacts (<18)	412,003
2021-03-01	Attended contacts (<18)	488,234
2021-04-01	Attended contacts (<18)	437,736
2021-05-01	Attended contacts (<18)	463,893
2021-06-01	Attended contacts (<18)	469,830
2021-07-01	Attended contacts (<18)	443,801
2021-08-01	Attended contacts (<18)	350,766
2021-09-01	Attended contacts (<18)	437,555

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp30d %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")

MEASURE_ID	MEASURE_KEY	year	average	months_included
MHS30d	Attended contacts (<18)	2020	398865.9	12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp30d <- CAMHS_reldata_cyp30d %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contacts (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp30d)

#Underlying data
CAMHS_reldata_cyp30d %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	pct_change_l1
2020-04-01	Attended contacts (<18)	18.834600
2020-05-01	Attended contacts (<18)	3.898593
2020-06-01	Attended contacts (<18)	25.883618
2020-07-01	Attended contacts (<18)	17.111393
2020-08-01	Attended contacts (<18)	22.729410
2020-09-01	Attended contacts (<18)	24.927109
2020-10-01	Attended contacts (<18)	12.233788
2020-11-01	Attended contacts (<18)	23.400898
2020-12-01	Attended contacts (<18)	30.064403
2021-01-01	Attended contacts (<18)	6.036967
2021-02-01	Attended contacts (<18)	14.072009
2021-03-01	Attended contacts (<18)	27.140629
2021-04-01	Attended contacts (<18)	19.858055
2021-05-01	Attended contacts (<18)	28.671521
2021-06-01	Attended contacts (<18)	10.593253
2021-07-01	Attended contacts (<18)	4.225124
2021-08-01	Attended contacts (<18)	4.185342
2021-09-01	Attended contacts (<18)	4.310398

Open referrals

• Measure code: CYP23
• Measure description: Open referrals (children’s and young people’s mental health services) at end of the reporting period
• Source: NHS England, Monthly MHSDS Statistics, Metadata

Raw time series

#Data
CAMHS_data_cyp23 <- CAMHS_data %>%
  filter(.,MEASURE_ID=="CYP23")
CAMHS_reldata_cyp23 <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="CYP23")

#Time series chart
CAMHS_raw_chart_cyp23 <- CAMHS_data_cyp23 %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp23)

#Underlying data
CAMHS_data_cyp23 %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	MEASURE_VALUE
2018-05-01	Open referrals	247,499
2018-06-01	Open referrals	251,573
2018-07-01	Open referrals	243,916
2018-08-01	Open referrals	238,803
2018-09-01	Open referrals	245,003
2018-10-01	Open referrals	255,855
2018-11-01	Open referrals	252,726
2018-12-01	Open referrals	256,644
2019-01-01	Open referrals	258,525
2019-02-01	Open referrals	264,305
2019-03-01	Open referrals	272,605
2019-04-01	Open referrals	248,038
2019-05-01	Open referrals	260,485
2019-06-01	Open referrals	255,950
2019-07-01	Open referrals	257,152
2019-08-01	Open referrals	248,313
2019-09-01	Open referrals	251,483
2019-10-01	Open referrals	256,252
2019-11-01	Open referrals	262,299
2019-12-01	Open referrals	261,939
2020-01-01	Open referrals	268,184
2020-02-01	Open referrals	272,482
2020-03-01	Open referrals	267,871
2020-04-01	Open referrals	307,837
2020-05-01	Open referrals	302,241
2020-06-01	Open referrals	301,012
2020-07-01	Open referrals	304,491
2020-08-01	Open referrals	300,469
2020-09-01	Open referrals	318,375
2020-10-01	Open referrals	329,392
2020-11-01	Open referrals	344,178
2020-12-01	Open referrals	345,569
2021-01-01	Open referrals	340,421
2021-02-01	Open referrals	340,218
2021-03-01	Open referrals	352,551
2021-04-01	Open referrals	358,282
2021-05-01	Open referrals	374,401
2021-06-01	Open referrals	379,079
2021-07-01	Open referrals	380,738
2021-08-01	Open referrals	368,610
2021-09-01	Open referrals	374,946

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp23 %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")

MEASURE_ID	MEASURE_KEY	year	average	months_included
CYP23	Open referrals	2019	258112.2	12
CYP23	Open referrals	2020	305175.1	12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp23 <- CAMHS_reldata_cyp23 %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contacts (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp23)

#Underlying data
CAMHS_reldata_cyp23 %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))

start_date	MEASURE_KEY	pct_change_l1
2019-05-01	Open referrals	5.246890
2019-06-01	Open referrals	1.739853
2019-07-01	Open referrals	5.426458
2019-08-01	Open referrals	3.982362
2019-09-01	Open referrals	2.644866
2019-10-01	Open referrals	0.155166
2019-11-01	Open referrals	3.787897
2019-12-01	Open referrals	2.063169
2020-01-01	Open referrals	3.736196
2020-02-01	Open referrals	3.093774
2020-03-01	Open referrals	-1.736579
2020-04-01	Open referrals	24.108806
2020-05-01	Open referrals	16.030098
2020-06-01	Open referrals	17.605782
2020-07-01	Open referrals	18.408957
2020-08-01	Open referrals	21.004136
2020-09-01	Open referrals	26.599015
2020-10-01	Open referrals	28.542216
2020-11-01	Open referrals	31.215902
2020-12-01	Open referrals	31.927281
2021-01-01	Open referrals	26.935611
2021-02-01	Open referrals	24.858890
2021-03-01	Open referrals	31.612231
2021-04-01	Open referrals	16.386919
2021-05-01	Open referrals	23.874987
2021-06-01	Open referrals	25.934846
2021-07-01	Open referrals	25.040806
2021-08-01	Open referrals	22.678213
2021-09-01	Open referrals	17.768669

People with eating disorders being seen within target times (<18)

• Measure code: ED86e

• Measure description: Proportion of referrals with eating disorders categorized as urgent cases entering treatment within one week in RP, aged 0-18

• Source: NHS England, Monthly MHSDS Statistics, Metadata

• Measure code: ED87e

• Measure description: Proportion of referrals with eating disorders categorized as routine cases entering treatment within four weeks in RP, aged 0-18

• Source: NHS England, Monthly MHSDS Statistics, Metadata

#Eating disorders data
target_time_ed_data_new <- MHSDS_main_pooled_dashboard %>%
  filter(.,PRIMARY_LEVEL_DESCRIPTION=="England",
         MEASURE_ID %in% c("ED86e","ED87e")) %>%
  select(.,start_date,end_date,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_VALUE)

target_time_ed_data <- MHSDS_ED_pooled_dashboard %>%
  filter(.,PRIMARY_LEVEL_DESCRIPTION=="England",
         MEASURE_ID %in% c("ED86e","ED87e")) %>%
  select(.,start_date,end_date,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_VALUE) %>%
  plyr::rbind.fill(.,target_time_ed_data_new) %>% 
  mutate(.,timing=ifelse(end_date<ymd("2020-04-01"),"Pre-COVID","Post-COVID")) %>%
  mutate(.,timing=fct_relevel(timing, c("Pre-COVID","Post-COVID"))) %>%
  mutate(.,MEASURE_VALUE=as.numeric(MEASURE_VALUE),
         Type=case_when(MEASURE_ID=="ED86e" ~ "urgent",
                        MEASURE_ID=="ED87e" ~ "non urgent",
                        TRUE ~ "NA"))

#Eating disorders chart
target_time_ed_chart <- target_time_ed_data %>%
  ggplot(., aes(x=end_date, y=MEASURE_VALUE, group=Type)) +
  geom_line(aes(color=Type),size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="", title="") +
  scale_colour_manual(values=
                        c("urgent" = "brown", "non urgent" = "darkseagreen4")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(target_time_ed_chart)

Health Education England data on workforce (compared to activity levels from NHS England)

• Source of staff numbers is Health Education England report

#NHS Digital on people in contact with CAMHS service
CAMHS_contacts <- MHSDS_main_pooled_dashboard %>%
  filter(.,PRIMARY_LEVEL_DESCRIPTION=="England",
         MEASURE_ID=="CYP01") %>%
  select(.,start_date,MEASURE_VALUE) %>%
  mutate(.,date_ymd=lubridate::ymd(start_date)) %>%
  mutate(.,date_ymd=floor_date(date_ymd, "month"),
         measure="People in contact CAMHS",
         MEASURE_VALUE=as.numeric(MEASURE_VALUE)) %>%
  select(.,-"start_date") %>%
  arrange(.,date_ymd)

#Turn into indexed data
CAMHS_contacts_index <- CAMHS_contacts %>%
  mutate(.,MEASURE_VALUE_MA=zoo::rollmean(MEASURE_VALUE,k=7,fill=NA)) %>% #Use a moving average to compute the mean
  mutate(.,Jan2019=filter(.,date_ymd=="2019-01-01")$MEASURE_VALUE_MA) %>%
  filter(.,date_ymd>=ymd("2019-01-01"),!is.na(MEASURE_VALUE_MA)) %>%
  mutate(.,index=MEASURE_VALUE_MA/Jan2019*100)

#HEE data (copied over from report)
HEE_staff_index <- data.frame(measure="CYP MH staff",
  date_ymd=as.Date(c("2019-01-01","2021-04-01")),
  MEASURE_VALUE=as.numeric(c("14857","20626"))) %>%
  mutate(.,Jan2019=filter(.,date_ymd=="2019-01-01")$MEASURE_VALUE) %>%
  mutate(.,index=MEASURE_VALUE/Jan2019*100)

#Append two sources together
CAMHS_and_HEE_staff <- plyr::rbind.fill(CAMHS_contacts_index,HEE_staff_index)

#Show data
CAMHS_and_HEE_staff %>%
  knitr::kable(., align = "lccrr")

MEASURE_VALUE	date_ymd	measure	MEASURE_VALUE_MA	Jan2019	index
229217	2019-01-01	People in contact CAMHS	228988.6	228988.6	100.00000
233831	2019-02-01	People in contact CAMHS	229359.7	228988.6	100.16208
241926	2019-03-01	People in contact CAMHS	229607.7	228988.6	100.27038
218678	2019-04-01	People in contact CAMHS	229460.3	228988.6	100.20600
230443	2019-05-01	People in contact CAMHS	227975.9	228988.6	99.55774
225480	2019-06-01	People in contact CAMHS	226204.0	228988.6	98.78397
226647	2019-07-01	People in contact CAMHS	223858.4	228988.6	97.75965
218826	2019-08-01	People in contact CAMHS	225581.4	228988.6	98.51209
221428	2019-09-01	People in contact CAMHS	225669.0	228988.6	98.55033
225507	2019-10-01	People in contact CAMHS	227228.4	228988.6	99.23134
230739	2019-11-01	People in contact CAMHS	229193.3	228988.6	100.08940
231056	2019-12-01	People in contact CAMHS	231802.1	228988.6	101.22870
236396	2020-01-01	People in contact CAMHS	240340.9	228988.6	104.95758
240401	2020-02-01	People in contact CAMHS	247226.4	228988.6	107.96453
237088	2020-03-01	People in contact CAMHS	253196.4	228988.6	110.57164
281199	2020-04-01	People in contact CAMHS	259536.9	228988.6	113.34053
273706	2020-05-01	People in contact CAMHS	264546.3	228988.6	115.52816
272529	2020-06-01	People in contact CAMHS	271186.1	228988.6	118.42781
275439	2020-07-01	People in contact CAMHS	279661.3	228988.6	122.12893
271462	2020-08-01	People in contact CAMHS	283677.3	228988.6	123.88273
286880	2020-09-01	People in contact CAMHS	289022.0	228988.6	126.21678
296414	2020-10-01	People in contact CAMHS	293994.3	228988.6	128.38819
309311	2020-11-01	People in contact CAMHS	298502.6	228988.6	130.35697
311119	2020-12-01	People in contact CAMHS	305128.7	228988.6	133.25063
307335	2021-01-01	People in contact CAMHS	310323.0	228988.6	135.51899
306997	2021-02-01	People in contact CAMHS	316181.9	228988.6	138.07757
317845	2021-03-01	People in contact CAMHS	320665.1	228988.6	140.03544
323240	2021-04-01	People in contact CAMHS	325157.4	228988.6	141.99723
337426	2021-05-01	People in contact CAMHS	328668.4	228988.6	143.53049
340694	2021-06-01	People in contact CAMHS	332966.0	228988.6	145.40726
14857	2019-01-01	CYP MH staff	NA	14857.0	100.00000
20626	2021-04-01	CYP MH staff	NA	14857.0	138.83018

NHS England data on workforce (child and adolescent psychiatry only)

#NHS data
NHS_workforce_doctors %>%
  mutate(.,date_ymd=lubridate::ymd(Date)) %>%
  mutate(.,date_ymd=floor_date(date_ymd, "month"),
         measure="FTE doctors") %>%
  rename(.,MEASURE_VALUE=FTE) %>%
  filter(Specialty %in% c("Child and adolescent psychiatry")) %>%
  group_by(date_ymd,measure,Specialty) %>%
  summarise(MEASURE_VALUE=sum(MEASURE_VALUE,na.rm=TRUE)) %>% #Aggregate over categories
  ungroup() %>%
  filter(., date_ymd %in% c(ymd("2019-01-01"),ymd("2021-04-01"))) %>%
  pivot_wider(
    names_from = date_ymd,
    names_sep = ".",
    values_from = MEASURE_VALUE
  ) %>%
  mutate(.,pct_change=(`2021-04-01`-`2019-01-01`)/`2019-01-01`*100) %>%
  knitr::kable(., align = "lccrr")

measure	Specialty	2019-01-01	2021-04-01	pct_change
FTE doctors	Child and adolescent psychiatry	981.6823	1064.256	8.411452

#Latest data on consultants
NHS_workforce_doctors %>%
  mutate(.,date_ymd=lubridate::ymd(Date)) %>%
  mutate(.,date_ymd=floor_date(date_ymd, "month"),
         measure="FTE doctors") %>%
  rename(.,MEASURE_VALUE=FTE) %>%
  filter(., date_ymd %in% c(ymd("2021-05-01"))) %>%
  filter(Specialty %in% c("Child and adolescent psychiatry"))  %>%
  select(.,-"Date") %>% 
  knitr::kable(., align = "lccrr")

Grade	Grade Order Code	Specialty Group	Specialty	MEASURE_VALUE	date_ymd	measure
Consultant	1	Psychiatry group	Child and adolescent psychiatry	626.5470	2021-05-01	FTE doctors
Associate Specialist	2	Psychiatry group	Child and adolescent psychiatry	13.3725	2021-05-01	FTE doctors
Specialty Doctor	3	Psychiatry group	Child and adolescent psychiatry	100.9210	2021-05-01	FTE doctors
Staff Grade	4	Psychiatry group	Child and adolescent psychiatry	3.5000	2021-05-01	FTE doctors
Specialty Registrar	5	Psychiatry group	Child and adolescent psychiatry	144.8688	2021-05-01	FTE doctors
Core Training	6	Psychiatry group	Child and adolescent psychiatry	142.1062	2021-05-01	FTE doctors
Foundation Doctor Year 2	7	Psychiatry group	Child and adolescent psychiatry	10.0000	2021-05-01	FTE doctors
Foundation Doctor Year 1	8	Psychiatry group	Child and adolescent psychiatry	10.0000	2021-05-01	FTE doctors